home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / rts / ratnum.scm < prev    next >
Text File  |  1995-10-13  |  4KB  |  142 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3. ; This is file ratnum.scm.
  4.  
  5. ; Rational arithmetic
  6. ; Assumes that +, -, etc. perform integer arithmetic.
  7.  
  8. (define-simple-type :exact-rational (:rational :exact)
  9.   (lambda (n) (and (rational? n) (exact? n))))
  10.  
  11. (define-extended-number-type :ratnum (:exact-rational :exact) ;?
  12.   (make-ratnum num den)
  13.   ratnum?
  14.   (num ratnum-numerator)
  15.   (den ratnum-denominator))
  16.  
  17. (define (integer/ m n)
  18.   (cond ((< n 0)
  19.      (integer/ (- 0 m) (- 0 n)))
  20.     ((= n 0)
  21.       (error "rational division by zero" m))
  22.     ((and (exact? m) (exact? n))
  23.      (let ((g (gcd m n)))
  24.        (let ((m (quotient m g))
  25.          (n (quotient n g)))
  26.          (if (= n 1)
  27.          m
  28.          (make-ratnum m n)))))
  29.     (else (/ m n))))    ;In case we get flonums
  30.  
  31. (define (rational-numerator p)
  32.   (if (ratnum? p)
  33.       (ratnum-numerator p)
  34.       (numerator p)))
  35.  
  36. (define (rational-denominator p)
  37.   (if (ratnum? p)
  38.       (ratnum-denominator p)
  39.       (denominator p)))
  40.  
  41. ; a/b * c/d = a*c / b*d
  42.  
  43. (define (rational* p q)
  44.   (integer/ (* (rational-numerator p) (rational-numerator q))
  45.         (* (rational-denominator p) (rational-denominator q))))
  46.  
  47. ; a/b / c/d = a*d / b*c
  48.  
  49. (define (rational/ p q)
  50.   (integer/ (* (rational-numerator p) (rational-denominator q))
  51.         (* (rational-denominator p) (rational-numerator q))))
  52.  
  53. ; a/b + c/d = (a*d + b*c)/(b*d)
  54.  
  55. (define (rational+ p q)
  56.   (let ((b (rational-denominator p))
  57.     (d (rational-denominator q)))
  58.     (integer/ (+ (* (rational-numerator p) d)
  59.          (* b (rational-numerator q)))
  60.           (* b d))))
  61.  
  62. ; a/b - c/d = (a*d - b*c)/(b*d)
  63.  
  64. (define (rational- p q)
  65.   (let ((b (rational-denominator p))
  66.     (d (rational-denominator q)))
  67.     (integer/ (- (* (rational-numerator p) d)
  68.          (* b (rational-numerator q)))
  69.           (* b d))))
  70.  
  71. ; a/b < c/d  when  a*d < b*c
  72.  
  73. (define (rational< p q)
  74.   (< (* (rational-numerator p) (rational-denominator q))
  75.      (* (rational-denominator p) (rational-numerator q))))
  76.  
  77. ; a/b = c/d  when a = b and c = d  (always lowest terms)
  78.  
  79. (define (rational= p q)
  80.   (and (= (rational-numerator p) (rational-numerator q))
  81.        (= (rational-denominator p) (rational-denominator q))))
  82.  
  83. ; (rational-truncate p) = integer of largest magnitude <= (abs p)
  84.  
  85. (define (rational-truncate p)
  86.   (quotient (rational-numerator p) (rational-denominator p)))
  87.  
  88. ; (floor p) = greatest integer <= p
  89.  
  90. (define (rational-floor p)
  91.   (let* ((n (numerator p))
  92.      (q (quotient n (denominator p))))
  93.     (if (>= n 0)
  94.     q
  95.     (- q 1))))
  96.  
  97.  
  98. ; Extend the generic number procedures
  99.  
  100. (define-method &rational? ((n :ratnum)) #t)
  101.  
  102. (define-method &numerator   ((n :ratnum)) (ratnum-numerator n))
  103. (define-method &denominator ((n :ratnum)) (ratnum-denominator n))
  104.  
  105. (define-method &exact? ((n :ratnum)) #t)
  106.  
  107. ;(define-method &exact->inexact ((n :ratnum))
  108. ;  (/ (exact->inexact (numerator n))
  109. ;     (exact->inexact (denominator n))))
  110.  
  111. ;(define-method &inexact->exact ((n :rational))  ;?
  112. ;  (/ (inexact->exact (numerator n))
  113. ;     (inexact->exact (denominator n))))
  114.  
  115. (define-method &/ ((m :exact-integer) (n :exact-integer))
  116.   (integer/ m n))
  117.  
  118. (define (define-ratnum-method mtable proc)
  119.   (define-method mtable ((m :ratnum) (n :exact-rational)) (proc m n))
  120.   (define-method mtable ((m :exact-rational) (n :ratnum)) (proc m n)))
  121.  
  122. (define-ratnum-method &+ rational+)
  123. (define-ratnum-method &- rational-)
  124. (define-ratnum-method &* rational*)
  125. (define-ratnum-method &/ rational/)
  126. (define-ratnum-method &= rational=)
  127. (define-ratnum-method &< rational<)
  128.  
  129. (define-method &floor ((m :ratnum)) (rational-floor m))
  130.  
  131. ;(define-method &sqrt ((p :ratnum))
  132. ;  (if (< p 0)
  133. ;      (next-method)
  134. ;      (integer/ (sqrt (numerator p))
  135. ;                (sqrt (denominator p)))))
  136.  
  137.  
  138. (define-method &number->string ((p :ratnum) radix)
  139.   (string-append (number->string (ratnum-numerator p) radix)
  140.          "/"
  141.          (number->string (ratnum-denominator p) radix)))
  142.